home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS01.ADF / ABasicStuff / Tools / Demo.bas < prev    next >
BASIC Source File  |  1985-12-04  |  19KB  |  494 lines
  1. 10    gosub 64000:REM Initialization
  2. 20    def fnGetX(x%)=x%
  3. 30    def fnGetY(y%)=y%
  4. 90    goto 10000
  5. 100   Data$="":REM LineRead
  6. 110   LRec%=TRec%:LByte%=Bptr%
  7. 115   If Bptr%>128 then gosub 200
  8. 120   CRPos%=instr(Bptr%,FI$,chr$(10))
  9. 130   if CRPos%=0 then Data$=right$(FI$,129%-Bptr%):GOSUB 200
  10. 140   Data$=Data$+mid$(FI$,Bptr%,CRPos%-Bptr%)
  11. 150   Bptr%=CRPos%+1
  12. 160   RETURN
  13. 200   REM Split off from buffer
  14. 205   RGet #10,Trec%:Trec%=Trec%+1
  15. 210   Bptr%=1
  16. 215   CRPos%=instr(Bptr%,FI$,chr$(10))
  17. 220   RETURN
  18. 300   Rem GET A TOKEN
  19. 305   token$=""
  20. 310   if tptr%>len(data$) then return
  21. 315   done%=0
  22. 320   while not done%:if mid$(data$,tptr%,1%)=" " then tptr%=tptr%+1:done%=tptr%>len(data$) else done%=-1:wend
  23. 330   DC$=mid$(data$,tptr%,1%)
  24. 340   if (dc$="'") or (dc$=chr$(34)) then tptr%=tptr%+1 else dc$=" "
  25. 350   Delim%=instr(tptr%,data$,dc$)
  26. 360   if Delim%=0 then Delim%=len(data$)+1%
  27. 370   token$=mid$(data$,tptr%,Delim%-tptr%)
  28. 380   tptr%=Delim%
  29. 390   if dc$<>" " then tptr%=tptr%+1
  30. 395   RETURN
  31. 800   REM DoFile
  32. 810   linedone%=0
  33. 820   while not linedone%:gosub 1000:wend
  34. 830   RETURN
  35. 1000  REM DoOneLine
  36. 1010  GOSUB 100
  37. 1020  if data$="" THEN 1090
  38. 1030  if mid$(data$,1%,1%)=";" then RETURN
  39. 1040  if mid$(data$,1%,1%)<>"%" THEN 1090
  40. 1050  tptr%=2%:gosub 300
  41. 1060  while token$<>"":cmdno%=instr(CMDSTR$,token$)-1
  42. 1065  if cmdno% mod 6<>0 then 1077
  43. 1068  if cmdno%=6 then close #4
  44. 1070  if cmdno%<12 then linedone%=-1:RETURN
  45. 1075  on int(cmdno%/6)-1 gosub 1800,1900,1100,1150,1700,1200,1250,1650,1300,1400,1450,2000,1600,2200
  46. 1077  gosub 300
  47. 1080  wend
  48. 1085  RETURN
  49. 1090  gosub 4000
  50. 1099  RETURN
  51. 1100  REM Handle "r" command
  52. 1110  gosub 300:crow%=val(token$):ccol%=1:goto 1160
  53. 1150  REM "@" command
  54. 1155  gosub 300:ccol%=val(token$):gosub 300:crow%=val(token$)
  55. 1160  print at (fnGetX(ccol%),fnGetY(crow%));
  56. 1170  RETURN
  57. 1200  REM "es"
  58. 1205  gosub 1250
  59. 1210  svcol%=ccol%:svrow%=crow%
  60. 1212  for crow%=svrow%+1 to WInfo%(cw%,3):ccol%=MargInfo%(cw%,crow%-1,0):gosub 1250:next
  61. 1220  ccol%=svcol%:crow%=svrow%
  62. 1225  gosub 1160
  63. 1230  RETURN
  64. 1250  REM "el"
  65. 1255  if ccol%<0 then 1299
  66. 1260  print at (fnGetX(ccol%),fnGetY(crow%));
  67. 1265  print spc(MargInfo%(cw%,crow%-1,1)-ccol%+1);
  68. 1299  RETURN
  69. 1300  REM Set up window
  70. 1305  gosub 300:tw%=val(token$)
  71. 1310  for i%=0 to 3:gosub 300:WInfo%(tw%,i%)=val(token$):next
  72. 1315  gosub 300
  73. 1320  rem gosub 300:wcolor%=val(token$):gosub 300:thick%=val(token$)
  74. 1335  close #tw%
  75. 1340  window #tw%,8*(WInfo%(tw%,0)-1),8*(WInfo%(tw%,1)-1),8*(WInfo%(tw%,2)+2),8*(WInfo%(tw%,3)+2),token$
  76. 1370  for ti%=1 to WInfo%(tw%,3):MargInfo%(tw%,ti%-1,0)=1:MargInfo%(tw%,ti%-1,1)=WInfo%(tw%,2):next
  77. 1390  gosub 1405
  78. 1399  RETURN
  79. 1400  REM "usew"
  80. 1402  gosub 300:tw%=val(token$)
  81. 1404  if tw%<0 or tw%>3 then RETURN
  82. 1405  savecol%(cw%)=ccol%:saverow%(cw%)=crow%
  83. 1410  cw%=tw%
  84. 1415  ccol%=savecol%(cw%):crow%=saverow%(cw%)
  85. 1417  cmd #tw%
  86. 1420  gosub 1160
  87. 1425  RETURN
  88. 1450  REM "margin"
  89. 1499  RETURN
  90. 1600  REM "wrap"
  91. 1610  gosub 300: if val(token$)=0 then wrap%=0 else wrap%=-1:RETURN
  92. 1650  REM "space"
  93. 1655  gosub 300:if val(token$)=1 then spacing%=1:RETURN
  94. 1660  if val(token$)=2 then spacing%=2
  95. 1665  RETURN
  96. 1700  REM "s"
  97. 1705  gosub 300:ti%=val(token$):if ti%<0 or ti%>19 then RETURN
  98. 1710  gosub 300:svar$(ti%)=token$:snum(ti%)=val(token$)
  99. 1720  RETURN
  100. 1800  RETURN
  101. 1900  gosub 300:ti%=val(token$)
  102. 1905  if ti%<0 or ti%>19 then RETURN
  103. 1910  FileMark%(ti%,0)=LRec%:FileMark%(ti%,1)=LByte%
  104. 1915  RETURN
  105. 1950  REM Jump to mark
  106. 1965  RETURN
  107. 2000  RETURN
  108. 2200  REM Draw a frame
  109. 2210  RETURN
  110. 4000  if instr(data$,"<")>0 then gosub 5000 :REM Fillvars
  111. 4005  tmax%=MargInfo%(cw%,crow%-1,1)-ccol%+1
  112. 4010  tstart%=1
  113. 4015  while len(data$)-tstart%+1>tmax%
  114. 4020  tj%=tstart%+tmax%-1
  115. 4025  if (not wrap%) or (tj%>len(data$)) or (mid$(data$,tj%,1)=" ") or (mid$(data$,tj%+1,1)=" ") then 4050
  116. 4030  while (tj%>=tstart%) and (mid$(data$,tj%,1)<>" "):tj%=tj%-1:wend
  117. 4040  if tj%<tstart% then tj%=tstart%+tmax%-1
  118. 4050  print mid$(data$,tstart%,tj%-tstart%+1);
  119. 4055  gosub 4400
  120. 4060  tstart%=tj%+1
  121. 4065  while (mid$(data$,tstart%,1)=" "):tstart%=tstart%+1:wend
  122. 4070  wend
  123. 4100  if tstart%>len(data$) then 4120
  124. 4110  print right$(data$,len(data$)-tstart%+1);
  125. 4120  if not wrap% then gosub 4400:goto 4300
  126. 4200  ccol%=ccol%+len(data$)-tstart%+1
  127. 4210  if right$(data$,1)<>" " and ccol%<>MargInfo%(cw%,crow%-1,1) then print " ";:ccol%=ccol%+1 else gosub 4400
  128. 4300  RETURN
  129. 4400  for ti%=1 to spacing%:crow%=crow%+1
  130. 4405  while MargInfo%(cw%,crow%-1,0)<0:crow%=crow%+1:if crow%>WInfo%(cw%,3) then crow%=1
  131. 4407  wend:next
  132. 4420  ccol%=MargInfo%(cw%,crow%-1,0)
  133. 4435  tmax%=MargInfo%(cw%,crow%-1,1)-ccol%+1
  134. 4440  gosub 1160
  135. 4450  RETURN
  136. 4500  if debug%=0 then 4510
  137. 4505  getkey x$:if asc(x$)=27 then END
  138. 4510  gosub 1160:return
  139. 4999  RETURN
  140. 5000  REM FillVars
  141. 5010  tstart%=instr(data$,"<")
  142. 5020  while tstart%<>0
  143. 5025  if mid$(data$,tstart%+1,1)="<" then data$=left$(data$,tstart%)+right$(data$,len(data$)-(tstart%+1)):tstart%=tstart%+1:goto 5070
  144. 5030  ti%=instr(tstart%,data$,">")
  145. 5040  if ti%=0 then RETURN
  146. 5050  tj%=val(mid$(data$,tstart%+1,ti%-(tstart%+1)))
  147. 5060  if tj%>=0 and tj%<=19 then data$=left$(data$,tstart%-1)+svar$(tj%)+right$(data$,len(data$)-ti%):tstart%=tstart%+len(svar$(tj%)) else tstart%=ti%+1
  148. 5070  tstart%=instr(tstart%,data$,"<")
  149. 5080  wend
  150. 5090  RETURN
  151. 5999  RETURN
  152. 10000 REM Main program begins here
  153. 10005 screen 1,3,0
  154. 10010 open "R",#10,"DEMO.TXT",128
  155. 10020 field #10,128 as FI$
  156. 10025 gosub 200
  157. 10030 wrap%=-1
  158. 10040 gosub 63000
  159. 10042 REM print fre(0):getkey x$
  160. 10045 ask rgb 7,holdr%,holdg%,holdb%
  161. 10047 ask rgb 0,tr%,tg%,tb%
  162. 10049 rgb 7,tr%,tg%,tb%:rgb 3,holdr%,holdg%,holdb%
  163. 10050 scnclr
  164. 10100 task%=1
  165. 10110 get x$:if x$=chr$(27) then rgb 7,holdr%,holdg%,holdb%:END
  166. 10115 if x$="" then 10280
  167. 10117 svtask%=task%
  168. 10120 if (x$<>chr$(155)) and active%(4) then task%=0:gosub 55300:cmd #0:goto 10275
  169. 10130 get x$:if x$="" then 10280
  170. 10140 if ((x$>="A") and (x$<="D")) and active%(4) then task%=0:x$=chr$(asc(x$)+128):gosub 55300:cmd #0:goto 10275
  171. 10150 if (x$<"0") or (x$>"3") then 10280
  172. 10200 task%=val(x$)+1
  173. 10210 get x$:REM get rid of "~"
  174. 10260 if active%(task%) then close #task%:active%(task%)=0:goto 10110
  175. 10270 stage%(task%)=0:active%(task%)=-1
  176. 10275 task%=svtask%
  177. 10280 gosub 60000
  178. 10290 goto 10110
  179. 19999 END
  180. 20000 REM plot alpha$(sb%,si%) BIG
  181. 20020 for sl%=1 to len(alpha$(sb%,si%))
  182. 20030 sshape (sl%*12+12,si%*yo%;sl%*12+24,si%*yo%+12),img1%()
  183. 20040 soffset%=6:color%=si%+1
  184. 20050 v%=vcset%+4+(asc(mid$(alpha$(sb%,si%),sl%,1))-32)*24
  185. 20060 while color%<>0
  186. 20070 if (color% mod 2)=1 then for sk%=0 to 23 step 4:poke_l vimg1%+soffset%+sk%,peek_l(v%+sk%):next
  187. 20080 color%=int(color%/2)
  188. 20090 soffset%=soffset%+24
  189. 20100 wend
  190. 20110 gshape (sl%*12+12,si%*yo%),img1%()
  191. 20120 next
  192. 20190 RETURN
  193. 20300 v%=vcset%+4+24*(asc(sc$)-32)
  194. 20310 for sk%=0 to 23 step 4:poke_l vone%+6+sk%,peek_l(v%+sk%):next
  195. 20320 RETURN
  196. 30000 scnclr:ask window wx%,wy%:pena 1:draw (2,0 to 2,wy%-1 to wx%,wy%-1 to wx%,wy%-2 to 3,wy%-2 to 3,0):RETURN
  197. 30100 gi%=0:stage%(task%)=stage%(task%)+1:RETURN
  198. 41000 if stage%(task%)<>0 then 41100
  199. 41010 data$=windata$(task%)
  200. 41020 gosub 1020
  201. 41030 stage%(task%)=1
  202. 41100 cmd #task%
  203. 41105 on stage%(task%) goto 41110,41200,41300,41400,41500,41600,41700,41800,41900,42000
  204. 41110 scnclr:for i%=0 to 4:j%=rnd*4:x$=alpha$(sb%,j%):alpha$(sb%,j%)=alpha$(sb%,i%):alpha$(sb%,i%)=x$:next
  205. 41120 for i%=0 to 4:print "  ";alpha$(sb%,i%):next
  206. 41130 si%=0:stage%(task%)=2
  207. 41200 print at (1,si%+1);">";
  208. 41210 sj%=si%+1
  209. 41220 stage%(task%)=3:RETURN
  210. 41300 print at (1,sj%+1);"?";
  211. 41310 if alpha$(sb%,si%)>alpha$(sb%,sj%) then stage%(task%)=4 else stage%(task%)=8
  212. 41320 RETURN
  213. 41400 print at (3,si%+1);spc(6);
  214. 41410 stage%(task%)=5:RETURN
  215. 41500 print at (3,si%+1);alpha$(sb%,sj%);
  216. 41510 stage%(task%)=6:RETURN
  217. 41600 print at (3,sj%+1);spc(6);
  218. 41610 stage%(task%)=7:RETURN
  219. 41700 print at (3,sj%+1);alpha$(sb%,si%);
  220. 41710 x$=alpha$(sb%,si%):alpha$(sb%,si%)=alpha$(sb%,sj%):alpha$(sb%,sj%)=x$
  221. 41720 stage%(task%)=8:RETURN
  222. 41800 print at (1,sj%+1);" ";
  223. 41810 sj%=sj%+1:if sj%<=4 then stage%(task%)=3 else stage%(task%)=9
  224. 41820 RETURN
  225. 41900 print at (1,si%+1);" ";
  226. 41910 si%=si%+1:if si%<4 then stage%(task%)=2 else stage%(task%)=10
  227. 41920 sc%=0
  228. 41930 RETURN
  229. 42000 if sc%<10 then sc%=sc%+1:RETURN
  230. 42010 scnclr:print "DONE!!!"
  231. 42020 sb%=(sb%+1) mod 3
  232. 42030 stage%(task%)=1:RETURN
  233. 52000 if stage%(task%)<>0 then 52050
  234. 52010 data$=windata$(task%)
  235. 52020 gosub 1020
  236. 52030 stage%(task%)=1
  237. 52040 substage%=0
  238. 52050 cmd #task%
  239. 52060 on stage%(task%) goto 52100,52150,52200,52300,52400,52500,52600,52700,52800,52900
  240. 52100 if substage%>0 then 52120
  241. 52105 scnclr:for i%=0 to 4:j%=rnd*4:x$=alpha$(sb%,j%):alpha$(sb%,j%)=alpha$(sb%,i%):alpha$(sb%,i%)=x$:next
  242. 52110 substage%=1:si%=0:RETURN
  243. 52120 if si%<5 then gosub 20000:si%=si%+1:RETURN
  244. 52140 si%=0:stage%(task%)=2:RETURN
  245. 52150 REM Put up >, set sj%
  246. 52155 sc$=">":gosub 20300:gshape (0,yo%*si%),one%()
  247. 52160 sj%=si%+1
  248. 52170 stage%(task%)=3:RETURN
  249. 52200 REM Put up "?", do compare
  250. 52205 sc$="?":gosub 20300:gshape (0,yo%*sj%),one%()
  251. 52210 if alpha$(sb%,si%)>alpha$(sb%,sj%) then stage%(task%)=4 else stage%(task%)=8
  252. 52220 RETURN
  253. 52300 REM Erase comparand
  254. 52310 sshape (12,yo%*si%;96,yo%*si%+12),img1%()
  255. 52315 pena 0: peno 0: box(12,yo%*si%;96,yo%*si%+12),1
  256. 52320 stage%(task%)=5:RETURN
  257. 52400 REM print comparand at top
  258. 52410 sshape (12,yo%*sj%;96,yo%*sj%+12),img2%()
  259. 52415 gshape (12,yo%*si%),img2%()
  260. 52420 stage%(task%)=6:RETURN
  261. 52500 REM Erase comparand
  262. 52510 pena 0:peno 0:box (12,yo%*sj%;96,yo%*sj%+12),1
  263. 52520 stage%(task%)=7:RETURN
  264. 52600 REM Print head at comparand, do real swap
  265. 52610 gshape (12,yo%*sj%),img1%()
  266. 52620 x$=alpha$(sb%,si%):alpha$(sb%,si%)=alpha$(sb%,sj%):alpha$(sb%,sj%)=x$
  267. 52630 stage%(task%)=8:RETURN
  268. 52700 REM erase "?"; increment sj% and test
  269. 52710 sc$=" ":gosub 20300:gshape (0,yo%*sj%),one%()
  270. 52720 sj%=sj%+1:if sj%<=4 then stage%(task%)=3 else stage%(task%)=9
  271. 52730 RETURN
  272. 52800 REM erase ">"; increment si% and test
  273. 52810 sc$=" ":gosub 20300:gshape (0,yo%*si%),one%()
  274. 52820 si%=si%+1:if si%<4 then stage%(task%)=2 else stage%(task%)=10
  275. 52830 sc%=0: REM subcount
  276. 52840 RETURN
  277. 52900 REM Done sorting
  278. 52910 REM if sc%=0 then graphic(1):print at (0,84);" DONE!";:graphic(0)
  279. 52920 if sc%<10 then sc%=sc%+1:RETURN
  280. 52930 scnclr:sb%=(sb%+1) mod 3
  281. 52940 stage%(task%)=1:substage%=0:RETURN
  282. 53000 if stage%(task%)<>0 then 53050
  283. 53010 data$=windata$(task%)
  284. 53020 gosub 1020
  285. 53030 stage%(task%)=1:RETURN
  286. 53040 gi%=-5
  287. 53050 cmd #task%
  288. 53060 on stage%(task%) goto 53100,53110,53180,53200,53250,53300,53400,53420,53450,53460,53500,53520,53550
  289. 53100 gosub 30000:gx%=-35:gosub 30100:RETURN
  290. 53110 ask window wx%,wy%
  291. 53120 gx%=gx%+40:if gx%>wx% then gosub 30100:RETURN
  292. 53130 gj%=rnd(1)*(wy%-3)
  293. 53140 if 2*rnd(1)<1 then pattern 8,pat1%() else pattern 8,pat2%()
  294. 53150 gk%=rnd(1)*5+1:pena gk%:peno gk%
  295. 53155 penb int(rnd(1)*8)
  296. 53160 box (gx%,gj%;gx%+30,wy%-3),1
  297. 53165 penb 0
  298. 53170 RETURN
  299. 53180 if gi%>10 then gosub 30100 else gi%=gi%+1
  300. 53190 RETURN
  301. 53200 scnclr:ask window gx%,gy%:grad%=gx%:if gy%<grad% then grad%=gy%
  302. 53205 gx%=gx%/2:gy%=gy%/2:grad%=(grad%-4)/2:pena 1:peno 1
  303. 53210 draw (gx%,gy% to gx%+2*grad%,gy%):for gj%=0 to 36:draw (to gx%+grad%*ctabl(gj%),gy%-grad%*stabl(gj%)):next
  304. 53220 gi%=0:angle(0)=0:angle(4)=36:stage%(task%)=5:RETURN
  305. 53250 if gi%=3 then gosub 30100: RETURN else gi%=gi%+1
  306. 53260 gj%=rnd(1)*11:if gj%<2 then gj%=gj%+2
  307. 53265 angle(gi%)=angle(gi%-1)+gj%
  308. 53270 pena 1:draw (gx%,gy% to gx%+grad%*ctabl(angle(gi%)),gy%-grad%*stabl(angle(gi%)))
  309. 53275 gpen%=rnd(1)*5+1
  310. 53280 RETURN
  311. 53300 if gi%=4 then gosub 30100:RETURN else gi%=gi%+1
  312. 53310 gpen%=((gpen%+1) mod 7)+1:pena gpen%:penb int(rnd(1)*8):peno 1
  313. 53315 af%(0)=gx%:af%(1)=gy%:gl%=2
  314. 53320 for gk%=angle(gi%-1) to angle(gi%)
  315. 53330 af%(gl%)=gx%+grad%*ctabl(gk%):af%(gl%+1)=gy%-grad%*stabl(gk%)
  316. 53340 gl%=gl%+2:next
  317. 53345 if 2*rnd(1)<1 then pattern 8,pat1%() else pattern 8,pat2%()
  318. 53350 mat area gl%/2,af%()
  319. 53360 penb 0
  320. 53370 RETURN
  321. 53400 if gi%>7 then gosub 30100 else gi%=gi%+1
  322. 53410 RETURN
  323. 53420 gosub 30000:gosub 30100:gstage%=stage%(task%):ggraf%=0:gpen%=(rnd(1)*5)+1:wy%=wy%-2:RETURN
  324. 53450 af%(0)=4:af%(1)=wy%:af%(2)=4:af%(3)=rnd(1)*(wy%*0.8):gx%=24:gl%=4
  325. 53460 while gx%<wx%:af%(gl%)=gx%:af%(gl%+1)=rnd(1)*(wy%*(.75-.2*(1-ggraf%)))+.2*ggraf%*wy%
  326. 53470 pena 1:draw (af%(gl%-2),af%(gl%-1) to af%(gl%),af%(gl%+1))
  327. 53480 gl%=gl%+2:gx%=gx%+20:wend
  328. 53490 af%(gl%)=wx%:af%(gl%+1)=rnd(1)*wy%
  329. 53495 af%(gl%+2)=wx%:af%(gl%+3)=wy%:gl%=gl%+4:gosub 30100:RETURN
  330. 53500 gpen%=((gpen%+1) mod 6)+1:pena gpen%:penb (rnd(1)*7):if rnd(1)*2>1 then pattern 8,pat1%() else pattern 8,pat2%()
  331. 53510 mat area gl%/2,af%():penb 0:gosub 30100
  332. 53520 if gi%<7 then gi%=gi%+1:RETURN
  333. 53530 ggraf%=ggraf%+1:if ggraf%=2 then gosub 30100 else stage%(task%)=gstage%
  334. 53540 RETURN
  335. 53550 if gi%>10 then gi%=0:stage%(task%)=1 else gi%=gi%+1
  336. 53560 RETURN
  337. 54000 if stage%(task%)=1 then 54100
  338. 54010 data$=windata$(task%)
  339. 54020 gosub 1020
  340. 54030 stage%(task%)=1
  341. 54100 cmd #task%
  342. 54110 print froth$(frct%)
  343. 54120 frct%=(frct%+1) mod 14
  344. 54130 RETURN
  345. 55000 if stage%(task%)<>0 then cmd #task%:goto 55100
  346. 55010 data$=windata$(task%)
  347. 55020 gosub 1020
  348. 55025 wline%=WInfo%(task%,3):wmaxcol%=WInfo%(task%,2)-2:wdim%=20
  349. 55030 stage%(task%)=1
  350. 55040 cmd #task%
  351. 55050 for wi%=1 to wline%:print wtext$(wi%);:if wi%<>wline% then print
  352. 55055 next
  353. 55060 wrr%=1:wpr%=1:wpc%=1
  354. 55065 cmd #0
  355. 55070 RETURN
  356. 55100 wcurs%=(-wcurs%)-1
  357. 55120 gosub 55150
  358. 55130 get x$:if x$<>"" then gosub 55300
  359. 55140 RETURN
  360. 55150 pena abs(wcurs%):draw (8*(wpc%-1),8*(wpr%-1) to 8*(wpc%-1),8*wpr%):RETURN
  361. 55300 cmd #4:wcurs%=0:gosub 55150:cmd #task%
  362. 55310 if x$=chr$(27) then RETURN
  363. 55315 if (x$>=chr$(192)) and (x$<=chr$(196)) then x$=chr$(asc(x$)-128):goto 55325
  364. 55320 if x$<>chr$(155) then 55330
  365. 55322 get x$
  366. 55325 cmd #4:if x$<>"" then wi%=asc(x$)-asc("@"):on wi% goto 55400,55420,55440,55460
  367. 55330 cmd #4:if x$=chr$(127) or x$=chr$(8) then goto 55900
  368. 55340 if x$=chr$(13) then 55500
  369. 55350 if x$>=" " then 55600
  370. 55370 RETURN
  371. 55400 if wrr%=1 then RETURN else wrr%=wrr%-1:wpr%=wpr%-1
  372. 55405 if wpr%<1 then print chr$(27);"[1T";at (1,1);wtext$(wrr%);:wpr%=1
  373. 55410 if wpc%>len(wtext$(wrr%)) then wpc%=len(wtext$(wrr%))+1
  374. 55415 RETURN
  375. 55420 if wrr%=wdim% then RETURN else wrr%=wrr%+1:wpr%=wpr%+1
  376. 55425 if wpr%<=wline% then 55410
  377. 55430 print chr$(27);"[1S";at (1,wline%);wtext$(wrr%);:wpr%=wline%
  378. 55435 goto 55410
  379. 55440 if wpc%<=len(wtext$(wrr%)) then wpc%=wpc%+1 else wpc%=1:goto 55420
  380. 55445 RETURN
  381. 55460 if wpc%>1 then wpc%=wpc%-1 else if wrr%>1 then wpc%=99:goto 55400
  382. 55465 RETURN
  383. 55500 wi%=wrr%:wtemp$=wtext$(wi%)
  384. 55505 wword$=mid$(wtemp$,wpc%):wtemp$=left$(wtemp$,wpc%-1)+chr$(171)
  385. 55510 print at (1,wpr%);wtemp$;chr$(27);"[1K":wtext$(wi%)=wtemp$
  386. 55520 while left$(wword$,1)=" ":wword$=mid$(wword$,2):wend
  387. 55530 if wi%=wdim% then RETURN
  388. 55540 gosub 55420:wpc%=1:x$=""
  389. 55545 wtext$(wrr%)=wword$+" "+wtext$(wrr%):goto 55600
  390. 55550 RETURN
  391. 55600 wtemp$=wtext$(wrr%)
  392. 55605 wtemp$=left$(wtemp$,wpc%-1)+x$+right$(wtemp$,len(wtemp$)-wpc%+1):wtext$(wrr%)=wtemp$
  393. 55610 if len(wtemp$)<=wmaxcol% then print at (1,wpr%);wtemp$;:gosub 55440:RETURN
  394. 55615 wi%=wrr%:worig%=wpc%
  395. 55620 wj%=wmaxcol%:while (wj%>1) and (mid$(wtemp$,wj%,1)<>" "):wj%=wj%-1:wend
  396. 55630 wword$=right$(wtemp$,len(wtemp$)-wj%)
  397. 55635 wtemp$=left$(wtemp$,wj%-1)
  398. 55640 wtext$(wi%)=wtemp$
  399. 55650 wl%=wpr%+(wi%-wrr%):if wl%<=wline% then print at (1,wl%);wtemp$;chr$(27);"[1K";
  400. 55660 if wi%=wdim% then gosub 55440:RETURN
  401. 55670 if right$(wword$,1)=chr$(171) then 55800
  402. 55675 wi%=wi%+1:wtemp$=wword$+" "+wtext$(wi%)
  403. 55680 wtext$(wi%)=wtemp$:wl%=wpr%+(wi%-wrr%)
  404. 55685 if len(wtemp$)>=wmaxcol% then 55620
  405. 55690 if wl%<=wline% then print at(1,wl%);wtemp$;
  406. 55700 wi%=wrr%:if x$<>"" then gosub 55440
  407. 55710 if wi%<>wrr% then wpc%=worig%-len(wtext$(wi%))
  408. 55750 RETURN
  409. 55800 for wj%=wdim%-1 to wi%+1 step -1: wtext$(wj%+1)=wtext$(wj%):next
  410. 55810 wi%=wi%+1:wtext$(wi%)=wword$
  411. 55820 for wj%=wpr% to wline%:print at (1,wj%);wtext$(wrr%+(wj%-wpr%));chr$(27);"[1K";:next
  412. 55840 goto 55700
  413. 55900 REM Handle DELETE
  414. 55905 gosub 55460
  415. 55907 wi%=wrr%
  416. 55910 wtemp$=wtext$(wi%)
  417. 55915 wtemp$=left$(wtemp$,wpc%-1)+right$(wtemp$,len(wtemp$)-wpc%)
  418. 55920 wtext$(wi%)=wtemp$
  419. 55925 if right$(wtemp$,1)=chr$(171) then gosub 56100:RETURN
  420. 55930 if wtemp$="" then gosub 56200:RETURN
  421. 55940 if wi%=wdim% then gosub 56100:RETURN
  422. 55945 wj%=wmaxcol%-len(wtemp$)
  423. 55950 if wj%>len(wtext$(wi%+1)) then wj%=len(wtext$(wi%+1))+1:goto 55970
  424. 55955 while (wj%>0) and mid$(wtext$(wi%+1),wj%,1)<>" ":wj%=wj%-1:wend
  425. 55960 if wj%=0 then gosub 56100:RETURN
  426. 55970 wtemp$=wtemp$+" "+left$(wtext$(wi%+1),wj%-1)
  427. 55975 gosub 56100
  428. 55980 wtext$(wi%)=wtemp$:wi%=wi%+1
  429. 55990 wtemp$=wtext$(wi%):wtemp$=right$(wtemp$,len(wtemp$)-wj%)
  430. 55995 goto 55920
  431. 56000 wtemp$=right$(wtemp$,len(wtemp$)-wj%)
  432. 56010 gosub 56100
  433. 56020 goto 55920
  434. 56100 if wpr%+wi%-wrr%<=wline% then print at (1,wpr%+wi%-wrr%);wtemp$;chr$(27);"[1K";
  435. 56110 RETURN
  436. 56200 for wj%=wi% to wdim%-1:wtext$(wj%)=wtext$(wj%+1):wl%=wj%-(wrr%-wpr%):if wl%<=wline% then print at (1,wl%);wtext$(wj%);chr$(27);"[1K";
  437. 56210 next: wtext$(wdim%)=""
  438. 56220 RETURN
  439. 60000 REM Task dispatcher
  440. 60010 tick%=tick%+1
  441. 60020 if tick%<tickmod% then RETURN
  442. 60030 tick%=0
  443. 60040 if active%(task%) then on task% gosub 54000,52000,53000,55000
  444. 60045 cmd #0
  445. 60050 task%=(task% mod maxtask%)+1
  446. 60060 RETURN
  447. 61999 END
  448. 63000 dim alpha$(2,4),active%(4),stage%(4)
  449. 63010 dim angle(4),af%(72),ctabl(36),stabl(36)
  450. 63015 dim pat1%(7),pat2%(7)
  451. 63020 dim froth$(14),windata$(4),wtext$(20)
  452. 63030 dim cset%(580),img1%(112),img2%(112),one%(20)
  453. 63040 maxtask%=4:yo%=14
  454. 63050 for i%=0 to 2:for j%=0 to 4:gosub 100:alpha$(i%,j%)=data$:next:next
  455. 63060 for i%=1 to maxtask%:gosub 100:windata$(i%)=data$:next
  456. 63070 i%=0:gosub 100
  457. 63080 while data$<>"---"
  458. 63090 if i%<15 then froth$(i%)=data$:i%=i%+1:gosub 100
  459. 63100 wend
  460. 63110 tickmod%=1
  461. 63120 i%=1:gosub 100
  462. 63130 while data$<>"---"
  463. 63140 if right$(data$,1)="*" then replace$(data$,len(data$),1)=chr$(171)
  464. 63150 if i%<=15 then wtext$(i%)=data$:i%=i%+1:gosub 100
  465. 63160 wend
  466. 63170 vcset%=varptr(cset%(0))
  467. 63180 vimg1%=varptr(img1%(0))
  468. 63190 vimg2%=varptr(img2%(0))
  469. 63200 vone%=varptr(one%(0)):poke vone%+1,1:poke vone%+3,12:poke vone%+5,12
  470. 63210 bload "twelvefont",vcset%
  471. 63220 for i%=0 to 36:stabl(i%)=sin(pi*10*i%/180):ctabl(i%)=2*cos(pi*10*i%/180):next
  472. 63230 for i%=0 to 7:read pat1%(i%):next:for i%=0 to 7:pat2%(i%)=65535:next
  473. 63500 RETURN
  474. 63510 data 61440,15360,3840,960,240,60,15,49155
  475. 64000 DIM MargInfo%(4,23,1),FileMark%(19,1),WInfo%(4,3)
  476. 64010 DIM SVar$(19),SNum(20),savecol%(4),saverow%(4)
  477. 64020 TRec%=1%:Bptr%=1%:LRec%=1%:LByte%=1%
  478. 64030 for i%=0 to 4
  479. 64040 for j%=0 to 23
  480. 64050 MargInfo%(i%,j%,0)=1
  481. 64060 MargInfo%(i%,j%,1)=37
  482. 64070 next:next
  483. 64080 for i%=0 to 4
  484. 64090 WInfo%(i%,0)=1:WInfo%(i%,1)=1
  485. 64100 WInfo%(i%,2)=37:WInfo%(i%,3)=23
  486. 64110 next
  487. 64120 cw%=0
  488. 64130 CMDSTR$="w     end   p     m     r     @     s     es    el    space windowusew  margindo    wrap  "
  489. 64135 CMDSTR$=CMDSTR$+"frame "
  490. 64140 wrap%=0:spacing%=1
  491. 64150 for i%=0 to 3:savecol%(i%)=1:saverow%(i%)=1:next
  492. 64160 RETURN
  493. 64170 end
  494.